home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Mode Examples / M2-Example.m2 < prev    next >
Encoding:
Text File  |  2000-10-30  |  10.5 KB  |  353 lines
  1. (* -*-M2-*- *)
  2.  
  3. (* M2-Example.mod
  4.  * 
  5.  * Included in the Alpha distribution as an example of the M2 mode
  6.  * 
  7.  * For best results you require not only the M2 mode installed in Alpha when
  8.  * opening these example files, but also at least MacMETH or better RAMSES.
  9.  * Both software packages are available as freeware and provide a full fledged
  10.  * (from simple to sophisticated) development environment for the beautiful
  11.  * (and small) Modula-2 language.
  12.  * 
  13.  * You find all what you need at
  14.  * 
  15.  * <http://www.ito.umnw.ethz.ch/SysEcol/>
  16.  * 
  17.  * and the best kept secret of the web site 
  18.  * 
  19.  * <http://www.ito.umnw.ethz.ch/SysEcol/SimSoftware/SimSoftware.html>
  20.  * 
  21.  * Andreas Fischlin, 30 May 2000 / ETH Zurich, Switzerland
  22.  *  
  23.  * These examples include:
  24.  *  
  25.  *   Simple.MOD
  26.  *   AlmostSimple.MOD
  27.  *   LessSimple.MOD
  28.  * 
  29.  * and of the use of ModelWorks, an interactive Simulation environment
  30.  * 
  31.  * <http://www.ito.umnw.ethz.ch/SysEcol/SimSoftware/RAMSES/ModelWorks.html>:
  32.  * 
  33.  *   Logistic.MOD
  34.  *  
  35.  *)
  36.  
  37.  
  38.    (***  Simple  ***)
  39.  
  40. MODULE Simple;
  41.   FROM DMMaster IMPORT RunDialogMachine;
  42. BEGIN
  43.   RunDialogMachine;
  44. END Simple.
  45.  
  46.    (***  Almost Simple  ***)
  47.  
  48. MODULE AlmostSimple;  (*A.Fischlin, 26/Jun/86*)
  49.  
  50.   (*************************************************************
  51.   
  52.      This program module demonstrates how to install a menu
  53.      and a command before starting the "Dialog Machine" and
  54.      the mechanism to provide an application specific action,
  55.      here the display of the waiting symbol during a delay.
  56.      Furthermore the program demonstrates how to produce
  57.      by means of a so-called alert a message telling the 
  58.      user that the application specific action has been 
  59.      terminated.
  60.      
  61.   *************************************************************)
  62.      
  63.   FROM DMAlerts IMPORT ShowAlert, WriteMessage;
  64.   
  65.   FROM DMMenus IMPORT Menu, InstallMenu, Command, InstallCommand, 
  66.     AccessStatus, Marking; 
  67.     
  68.   FROM DMMaster IMPORT RunDialogMachine, 
  69.     ShowWaitSymbol, Wait, HideWaitSymbol;
  70.  
  71.                                      
  72.   VAR
  73.     myMenu: Menu;
  74.       aCommand: Command;
  75.     
  76.  
  77.   PROCEDURE HiImFinished;
  78.   BEGIN
  79.     WriteMessage(2,4,"Hello!  I'm finished.");
  80.   END HiImFinished;
  81.     
  82.   PROCEDURE TheBigAction;
  83.     VAR i: INTEGER;
  84.   BEGIN
  85.     FOR i:= 1 TO 10 DO 
  86.       ShowWaitSymbol; 
  87.       Wait(60) (* ≈ 1 second *); 
  88.     END;
  89.     HideWaitSymbol; ShowAlert(3,35,HiImFinished);
  90.   END TheBigAction;
  91.   
  92.   
  93.   PROCEDURE InitDM;
  94.   BEGIN
  95.     InstallMenu(myMenu,"Do something",enabled);
  96.     InstallCommand(myMenu,aCommand,"boring...",TheBigAction,
  97.                    enabled,unchecked);
  98.   END InitDM;
  99.   
  100.   
  101. BEGIN
  102.   InitDM;
  103.   RunDialogMachine;
  104. END AlmostSimple.
  105.  
  106.  
  107.    (***  Less Simple  ***)
  108.  
  109. MODULE LessSimple; (*A.Fischlin, Mai 86*)
  110.  
  111.   (**************************************************************)
  112.   (*   Sample program module demonstrating the installation     *)
  113.   (*   of menus, the window management, inclusive content       *)
  114.   (*   restoration and some drawing within the window as        *)
  115.   (*   supported by the "Dialog Machine"                        *)
  116.   (**************************************************************)
  117.   
  118.                       
  119.   FROM DMMenus IMPORT  Menu, Command, AccessStatus, Marking,
  120.     InstallMenu, InstallCommand, InstallAliasChar, Separator,
  121.     InstallSeparator, DisableCommand, EnableCommand, 
  122.     ChangeCommandText;
  123.                        
  124.   FROM DMWindows IMPORT Window, WindowsDone, notExistingWindow,
  125.     WindowKind, ScrollBars, CloseAttr, ZoomAttr, WFFixPoint, 
  126.     WindowFrame, CreateWindow, SetRestoreProc, DummyRestoreProc,
  127.     AutoRestoreProc, GetWindowFrame;
  128.  
  129.   FROM DMWindIO IMPORT SelectForOutput, Circle, Pattern;
  130.                         
  131.   FROM DMMaster IMPORT MouseHandlers, AddMouseHandler,
  132.     AddSetupProc, RunDialogMachine;
  133.     
  134.  
  135.  
  136.   TYPE
  137.     MachineStates = (myWindowDoesNotExist,
  138.                      myWindowExistsButNoAutomaticUpdating,
  139.                      myWindowExistsWithRestoreUpdating,
  140.                      myWindowExistsWithAutoRestoreUpdating);
  141.  
  142.  
  143.   VAR
  144.     myMenu: Menu;
  145.     makeWindow, drawCircle, ordUpdating, autoUpdating: Command;
  146.     myWindow: Window; wf: WindowFrame;
  147.     curDMState: MachineStates;
  148.  
  149.  
  150.   PROCEDURE CircleRestoreProc(u: Window);
  151.     VAR radius: INTEGER; filled: BOOLEAN; dummyPat: Pattern;
  152.     PROCEDURE Minimum(x,y: CARDINAL): CARDINAL;
  153.     BEGIN (*Minimum*)
  154.       IF x<y THEN RETURN x ELSE RETURN y END
  155.     END Minimum;
  156.   BEGIN (*CircleRestoreProc*)
  157.     GetWindowFrame(u,wf);
  158.     radius:= Minimum(wf.h DIV 3,wf.w DIV 3);
  159.     filled:= FALSE;
  160.     Circle(wf.w DIV 2,wf.h DIV 2,radius,filled,dummyPat)
  161.   END CircleRestoreProc;
  162.  
  163.   PROCEDURE DrawCircle;
  164.   BEGIN
  165.     SelectForOutput(myWindow);
  166.     CircleRestoreProc(myWindow);
  167.   END DrawCircle;
  168.  
  169.  
  170.  
  171.   CONST
  172.     clRPStr = "Install your own restore procedure";
  173.     auRPStr = "Install DM's automatic restoring mechanism (AutoRestoreProc)";
  174.     rmClRPStr = "Remove your own restore procedure";
  175.     rmAuRPStr = "Remove automatic restoring";
  176.  
  177.   PROCEDURE SetDMState(s: MachineStates);
  178.   BEGIN
  179.     CASE s OF
  180.       myWindowDoesNotExist:
  181.               myWindow:= notExistingWindow;
  182.               EnableCommand(myMenu, makeWindow);
  183.               DisableCommand(myMenu, drawCircle);
  184.               DisableCommand(myMenu, ordUpdating);
  185.               DisableCommand(myMenu, autoUpdating);
  186.     | myWindowExistsButNoAutomaticUpdating:
  187.               DisableCommand(myMenu, makeWindow);
  188.               EnableCommand(myMenu, drawCircle);
  189.               EnableCommand(myMenu, ordUpdating);
  190.               EnableCommand(myMenu, autoUpdating);
  191.               SetRestoreProc(myWindow,DummyRestoreProc);
  192.               ChangeCommandText(myMenu,ordUpdating,clRPStr);
  193.               ChangeCommandText(myMenu,autoUpdating,auRPStr);
  194.     | myWindowExistsWithRestoreUpdating:
  195.               DisableCommand(myMenu, makeWindow);
  196.               DisableCommand(myMenu, drawCircle);
  197.               EnableCommand(myMenu, ordUpdating);
  198.               DisableCommand(myMenu, autoUpdating);
  199.               SetRestoreProc(myWindow,CircleRestoreProc);
  200.               ChangeCommandText(myMenu,ordUpdating,rmClRPStr);
  201.               ChangeCommandText(myMenu,autoUpdating,rmAuRPStr);
  202.     | myWindowExistsWithAutoRestoreUpdating:
  203.               DisableCommand(myMenu, makeWindow);
  204.               EnableCommand(myMenu, drawCircle);
  205.               DisableCommand(myMenu, ordUpdating);
  206.               EnableCommand(myMenu, autoUpdating);
  207.               SetRestoreProc(myWindow,AutoRestoreProc);
  208.               ChangeCommandText(myMenu,ordUpdating,rmClRPStr);
  209.               ChangeCommandText(myMenu,autoUpdating,rmAuRPStr);
  210.     END(*CASE*);
  211.     curDMState:= s;
  212.   END SetDMState;
  213.  
  214.  
  215.   PROCEDURE MakeWindow;
  216.   BEGIN
  217.     wf.x:= 50; wf.y:= 50; wf.w:= 200; wf.h:= 200;
  218.     CreateWindow(myWindow,
  219.                  GrowOrShrinkOrDrag, WithoutScrollBars,
  220.                  WithCloseBox, WithoutZoomBox, bottomLeft,
  221.                  wf, "My Window", DummyRestoreProc);
  222.     IF WindowsDone THEN
  223.       SetDMState(myWindowExistsButNoAutomaticUpdating)
  224.     END(*IF*);
  225.   END MakeWindow;
  226.  
  227.   PROCEDURE EnableMenuIfWindowCloses(u: Window);
  228.   BEGIN
  229.     SetDMState(myWindowDoesNotExist);
  230.   END EnableMenuIfWindowCloses;
  231.  
  232.  
  233.   
  234.  
  235.   PROCEDURE ToggleUpdtInstallation;
  236.   BEGIN
  237.     IF curDMState = myWindowExistsButNoAutomaticUpdating THEN
  238.       SetDMState(myWindowExistsWithRestoreUpdating);
  239.     ELSIF curDMState = myWindowExistsWithRestoreUpdating THEN
  240.       SetDMState(myWindowExistsButNoAutomaticUpdating);
  241.     END(*IF*);
  242.   END ToggleUpdtInstallation;
  243.   
  244.   PROCEDURE ToggleAutoUpdtInstallation;
  245.   BEGIN
  246.     IF curDMState = myWindowExistsButNoAutomaticUpdating THEN
  247.       SetDMState(myWindowExistsWithAutoRestoreUpdating);
  248.     ELSIF curDMState = myWindowExistsWithAutoRestoreUpdating THEN
  249.       SetDMState(myWindowExistsButNoAutomaticUpdating);
  250.     END(*IF*);
  251.   END ToggleAutoUpdtInstallation;
  252.  
  253.   
  254.  
  255.  
  256.   PROCEDURE SettingUp;
  257.     (* Menus are now installed in the "Dialog Machine", since this 
  258.     procedure will be called automatically after you have activated
  259.     it by calling DMMaster.RunDialogMachine.  Any menu command texts
  260.     etc. may now be changed the same way as during the ordinary 
  261.     running of the "Dialog Machine" *)
  262.   BEGIN
  263.     SetDMState(myWindowDoesNotExist);
  264.   END SettingUp;
  265.  
  266.   PROCEDURE DMInitialization;
  267.     (* This procedure is called in order to install menus etc. into the
  268.     "Dialog Machine" before it is actually activated by calling procedure
  269.     DMMaster.RunDialogMachine *)
  270.   BEGIN
  271.     InstallMenu(myMenu,"Control",enabled);
  272.     InstallCommand(myMenu, makeWindow,"Open Window", MakeWindow,
  273.                    enabled, unchecked);
  274.     InstallCommand(myMenu,drawCircle,"Draw Circle", DrawCircle,
  275.                    disabled,unchecked);
  276.     InstallAliasChar(myMenu, drawCircle,"D");
  277.     InstallSeparator(myMenu,line);
  278.     InstallCommand(myMenu,ordUpdating,clRPStr,
  279.                    ToggleUpdtInstallation,disabled,unchecked);
  280.     InstallCommand(myMenu,autoUpdating, auRPStr,
  281.                    ToggleAutoUpdtInstallation,disabled,unchecked);
  282.     AddSetupProc(SettingUp, 0);
  283.     AddMouseHandler(CloseWindow,EnableMenuIfWindowCloses, 0);
  284.   END DMInitialization;
  285.  
  286.  
  287. BEGIN
  288.   DMInitialization;
  289.   RunDialogMachine
  290. END LessSimple.
  291.  
  292.  
  293.   (***  Logistic  ***)
  294.  
  295.  
  296. MODULE Logistic;
  297.  
  298.   (********************************)
  299.   (* MODEL: Logistic grass growth *)
  300.   (* Author: mu, 9.4.88, ETHZ     *)
  301.   (********************************)
  302.  
  303.   FROM SimBase IMPORT
  304.     Model, IntegrationMethod, DeclM, DeclSV, DeclP, RTCType, 
  305.     StashFiling, Tabulation, Graphing, DeclMV, SetSimTime,
  306.     NoInitialize, NoInput, NoOutput, NoTerminate, NoAbout,
  307.     StateVar, Derivative, Parameter;
  308.  
  309.   FROM SimMaster IMPORT RunSimEnvironment;
  310.  
  311.  
  312.   VAR 
  313.     m:        Model;
  314.     grass:    StateVar;
  315.     grassDot: Derivative;
  316.     c1, c2:   Parameter;
  317.  
  318.  
  319.   PROCEDURE Dynamic;
  320.   BEGIN
  321.     grassDot:=  c1*grass - c2*grass*grass;
  322.   END Dynamic;
  323.  
  324.  
  325.   PROCEDURE ModelObjects;
  326.   BEGIN
  327.     DeclSV(grass, grassDot,1.0, 0.0, 10000.0,
  328.       "Grass", "G", "g dry weight/m^2");
  329.       
  330.     DeclMV(grass, 0.0,1000.0, "Grass", "G", "g dry weight/m^2", 
  331.       notOnFile, writeInTable, isY);
  332.     DeclMV(grassDot, 0.0,500.0, "Grass derivative", "GDot", "g dry weight/m^2/day", 
  333.       notOnFile, notInTable, notInGraph);
  334.       
  335.     DeclP(c1, 0.7, 0.0, 10.0, rtc, 
  336.       "c1 (growth rate of grass)",  "c1", "/day");
  337.     DeclP(c2, 0.001, 0.0, 1.0, rtc, 
  338.       "c2 (self inhibition coefficient of grass)",  "c2", "m^2/g dw/day");
  339.   END ModelObjects;
  340.  
  341.  
  342.   PROCEDURE ModelDefinitions;
  343.   BEGIN
  344.     DeclM(m, Euler, NoInitialize, NoInput, NoOutput, Dynamic, 
  345.           NoTerminate, ModelObjects, "Logistic grass growth model", 
  346.           "LogGrowth", NoAbout);
  347.     SetSimTime(0.0,30.0);
  348.   END ModelDefinitions;
  349.  
  350.   
  351. BEGIN
  352.   RunSimEnvironment(ModelDefinitions);
  353. END Logistic.